home *** CD-ROM | disk | FTP | other *** search
/ Super OZ Shareware: Games / SuperOZ Shareware, Games Volume 1.iso / BOARD / HANG-MAN.ZIP / HANGMAN.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-26  |  43KB  |  1,374 lines
  1. PROGRAM Hangman(INPUT, OUTPUT, PlacEasy, PlacMedm, PlacHard, ThngEasy, ThngMedm, ThngHard, PeplEasy, PeplMedm, PeplHard);
  2. USES CRT,GRAPH;
  3. {$M 65520,0,655360}
  4.  
  5.  
  6.  
  7. (* This program is designed to be an easy-to-use, easy-to explain
  8.    game to be used by young children.  It can be used by people of
  9.    all ages, but it is specifically designed for a young age group.
  10.  
  11.    Program Designed by: Jeremy Gerlach
  12.    Date Started       : February 16, 1993
  13.    Date Completed     : March 23, 1993
  14.    Client             : Prof. Gary Locklair
  15.    Version            : 1.5
  16.    I.D.#              : 500037
  17.    In-House Name      : Hang Him                                    *)
  18.  
  19. (*------------------------ Code Starts Here ------------------------*)
  20.  
  21. (*----------------------- User Defined Codes -----------------------*)
  22.  
  23. CONST
  24.  
  25.    Esc = #27;
  26.    F1 = #59;
  27.    F2 = #60;
  28.    MaxGuesses = 40;
  29.    MaxWordChoices = 70;
  30.  
  31. TYPE
  32.  
  33.     GuessIndexType = 1..MaxGuesses;
  34.     WordIndexType = 1..MaxWordChoices;
  35.     StringType1 = STRING[1];
  36.     StringType32 = STRING[32];
  37.     WordRecType = RECORD
  38.                     EasyPlaces,
  39.                     MediumPlaces,
  40.                     HardPlaces,
  41.                     EasyThings,
  42.                     MediumThings,
  43.                     HardThings,
  44.                     EasyPeople,
  45.                     MediumPeople,
  46.                     HardPeople: StringType32
  47.                   END;
  48.     CorrectGuessArrayType = ARRAY [1..32] OF StringType1;
  49.     WordRecArrayType = ARRAY[WordIndexType] OF WordRecType;
  50.     GuessArrayType = ARRAY[GuessIndexType] OF CHAR;
  51.  
  52. VAR
  53.  
  54.    GuessArray:
  55.       GuessArrayType;
  56.    Continue,
  57.    EntryError:
  58.       BOOLEAN;
  59.    WordRecArray:
  60.       WordRecArrayType;
  61.    Category,
  62.    NextScreen,
  63.    PlayAgain,
  64.    DifficultyLevel:
  65.       CHAR;
  66.    WordToBeGuessed:
  67.       StringType32;
  68.    NumGuesses:
  69.       INTEGER;
  70.  
  71. (***************************** Procedures ***************************)
  72.  
  73. (*----------------------------------------------------------------*)
  74.  
  75. PROCEDURE Introduction(VAR WordRecArray:
  76.                              WordRecArrayType;
  77.                            NextScreen:
  78.                               CHAR         );
  79.  
  80.  
  81. (* This procedure first reads the word files into an array of records. *)
  82. (* Then the user is welcomed to the program. *)
  83. VAR
  84.    EasyPlaceIn,
  85.    MediumPlaceIn,
  86.    HardPlaceIn,
  87.    EasyThingIn,
  88.    MediumThingIn,
  89.    HardThingIn,
  90.    EasyPeopleIn,
  91.    MediumPeopleIn,
  92.    HardPeopleIn:
  93.       TEXT;
  94.    Count:
  95.       INTEGER;
  96.  
  97. BEGIN
  98.  
  99.    ASSIGN (EasyPlaceIn, 'PlacEasy.WRD');
  100.    ASSIGN (MediumPlaceIn, 'PlacMedm.WRD');
  101.    ASSIGN (HardPlaceIn, 'PlacHard.WRD');
  102.    ASSIGN (EasyThingIn, 'ThngEasy.WRD');
  103.    ASSIGN (MediumThingIn, 'ThngMedm.WRD');
  104.    ASSIGN (HardThingIn, 'ThngHard.WRD');
  105.    ASSIGN (EasyPeopleIn, 'PeplEasy.WRD');
  106.    ASSIGN (MediumPeopleIn, 'PeplMedm.WRD');
  107.    ASSIGN (HardPeopleIn, 'PeplHard.WRD');
  108.    RESET (EasyPlaceIn);
  109.    RESET (MediumPlaceIn);
  110.    RESET (HardPlaceIn);
  111.    RESET (EasyThingIn);
  112.    RESET (MediumThingIn);
  113.    RESET (HardThingIn);
  114.    RESET (EasyPeopleIn);
  115.    RESET (MediumPeopleIn);
  116.    RESET (HardPeopleIn);
  117.  
  118.    (* Array of records of words is filled with this FOR loop. *)
  119.    FOR Count := 1 TO 70 DO
  120.       BEGIN
  121.          READLN (EasyPlaceIn, WordRecArray[Count].EasyPlaces);
  122.          READLN (MediumPlaceIn, WordRecArray[Count].MediumPlaces);
  123.          READLN (HardPlaceIn, WordRecArray[Count].HardPlaces);
  124.          READLN (EasyThingIn, WordRecArray[Count].EasyThings);
  125.          READLN (MediumThingIn, WordRecArray[Count].MediumThings);
  126.          READLN (HardThingIn, WordRecArray[Count].HardThings);
  127.          READLN (EasyPeopleIn, WordRecArray[Count].EasyPeople);
  128.          READLN (MediumPeopleIn, WordRecArray[Count].MediumPeople);
  129.          READLN (HardPeopleIn, WordRecArray[Count].HardPeople)
  130.       END;
  131.  
  132.    CLRSCR;
  133.    WRITELN;
  134.    WRITELN('                    HANGMAN');
  135.    WRITELN;
  136.    WRITELN;
  137.    WRITELN('WELCOME to the game of Hangman.  This game is meant to provide fun');
  138.    WRITELN('for people of all ages.  Hangman is easy to play and understand.');
  139.    WRITELN;
  140.    WRITELN('   If you need any help at any time during the game simply press');
  141.    WRITELN('function key 1 (F1).  This is the help key.  It will provide you');
  142.    WRITELN('with helpful information on how to proceed.');
  143.    WRITELN;
  144.    WRITELN;
  145.    WRITELN('   Enjoy your game!!');
  146.    WRITELN;
  147.    WRITELN;
  148.    WRITELN;
  149.    WRITELN('Press any key to continue.');
  150.    NextScreen := READKEY;
  151.    IF (NextScreen = #0)
  152.       THEN
  153.          NextScreen := READKEY
  154.  
  155. END;
  156.  
  157.  
  158. (*----------------------------------------------------------------*)
  159.  
  160. PROCEDURE CategoryHelp (    NextScreen:
  161.                                CHAR    );
  162.  
  163. (* This procedure provides some help insight *)
  164. (* in choosing a category. *)
  165.  
  166. BEGIN
  167.  
  168.    CLRSCR;
  169.    WRITELN;
  170.    WRITELN('                    HANGMAN');
  171.    WRITELN;
  172.    WRITELN;
  173.    WRITELN('The choice you must make is the type of word that you want to guess.');
  174.    WRITELN('If you wish to guess a place, you must choose that by pressing the number 1.');
  175.    WRITELN('You can choose to guess a thing by pressing the number 2.');
  176.    WRITELN('You can choose to guess a person just by pressing the number 3.');
  177.    WRITELN('The final category you can choose is miscellaneous.');
  178.    WRITELN('This category includes all of the words from the first three categories.');
  179.    WRITELN('You could get any word to guess if you choose miscellaneous.');
  180.    WRITELN('Choose this category by pressing the number 4.');
  181.    WRITELN;
  182.    WRITELN;
  183.    WRITELN('Press any key to make your choice.');
  184.    NextScreen := READKEY;
  185.    IF (NextScreen = #0)
  186.       THEN
  187.          NextScreen := READKEY
  188.  
  189. END;
  190.  
  191.  
  192. (*----------------------------------------------------------------*)
  193.  
  194. PROCEDURE DifficultyLevelHelp (    NextScreen:
  195.                                       CHAR    );
  196.  
  197. (* This procedure provides some helpful insight *)
  198. (* to the user on choosing a difficulty level. *)
  199.  
  200. BEGIN
  201.  
  202.    CLRSCR;
  203.    WRITELN;
  204.    WRITELN('                    HANGMAN');
  205.    WRITELN;
  206.    WRITELN;
  207.    WRITELN('Now you get to choose the difficulty level of the word you are going to guess.');
  208.    WRITELN('There are three difficulty levels to choose from: Easy, Medium, and Hard.');
  209.    WRITELN('The Easy difficulty level for the most part has short words.');
  210.    WRITELN('And the Hard difficulty level has long words.  It follows that the');
  211.    WRITELN('Medium difficulty level has words that are in between long and short.');
  212.    WRITELN('You can choose the Easy difficulty level just by pressing the number 1.');
  213.    WRITELN('You can choose the Medium difficulty level simply by pressing the number 2.');
  214.    WRITELN('And the Hard difficulty level can be played by pressing the number 3.');
  215.    WRITELN;
  216.    WRITELN;
  217.    WRITELN('Press any key to make your choice.');
  218.    NextScreen := READKEY;
  219.    IF (NextScreen = #0)
  220.       THEN
  221.          NextScreen := READKEY
  222.  
  223. END;
  224.  
  225.  
  226. (*----------------------------------------------------------------*)
  227.  
  228. PROCEDURE PlayAgainHelp (    NextScreen:
  229.                                 CHAR    );
  230.  
  231. (* This procedure provides some helpful insight *)
  232. (* to the user on deciding to play again or not. *)
  233.  
  234. BEGIN
  235.  
  236.    CLRSCR;
  237.    WRITELN;
  238.    WRITELN('                    HANGMAN');
  239.    WRITELN;
  240.    WRITELN;
  241.    WRITELN('You must choose whether or not you want to play another game of Hangman.');
  242.    WRITELN('If you do want to play again you can simply press the letter "Y" for yes.');
  243.    WRITELN('Or if you do not want to play again you can just press the letter "N" for no.');
  244.    WRITELN('It does not need to be a capital "Y" or "N".');
  245.    WRITELN('You must just press one or the other.');
  246.    WRITELN;
  247.    WRITELN;
  248.    WRITELN('Press any key to make your choice.');
  249.    NextScreen := READKEY;
  250.    IF (NextScreen = #0)
  251.       THEN
  252.          NextScreen := READKEY
  253.  
  254. END;
  255.  
  256.  
  257. (*----------------------------------------------------------------*)
  258.  
  259. PROCEDURE Options (VAR Category,
  260.                        DifficultyLevel,
  261.                        NextScreen:
  262.                           CHAR;
  263.                        EntryError,
  264.                        Continue:
  265.                           BOOLEAN      );
  266.  
  267. (* This procedure obtains the user's choice of category and difficulty level. *)
  268.  
  269. BEGIN
  270.  
  271. (* This is where the category menu is displayed *)
  272. (* and the user's choice is obtained. *)
  273.  
  274.    EntryError := FALSE;
  275.    REPEAT
  276.       CLRSCR;
  277.       WRITELN;
  278.       WRITELN('                    HANGMAN');
  279.       WRITELN;
  280.       WRITELN;
  281.       WRITELN;
  282.       WRITELN('What category would you like?');
  283.       WRITELN;
  284.       WRITELN('     1. PLACES');
  285.       WRITELN('     2. THINGS');
  286.       WRITELN('     3. PEOPLE');
  287.       WRITELN('     4. MISCELLANEOUS');
  288.       WRITELN;
  289.       IF (EntryError)       (* Displays error message if needed. *)
  290.          THEN
  291.             BEGIN
  292.                WRITELN('You have entered an incorrect choice.');
  293.                WRITELN('Please reenter your choice (1, 2, 3, 4, or F1 for help).')
  294.             END
  295.          ELSE
  296.             WRITELN('Please enter your choice (1, 2, 3, 4, or F1 for help).');
  297.  
  298.       Category := READKEY;
  299.       IF (Category = #0)
  300.          THEN
  301.             BEGIN
  302.                Category := READKEY;
  303.                IF (Category = F1)       (* Checks if the user asked for help. *)
  304.                   THEN
  305.                      BEGIN
  306.                         CategoryHelp(NextScreen);
  307.                         EntryError := FALSE;
  308.                         Continue := FALSE
  309.                      END
  310.             END
  311.          ELSE IF ((Category >= '1') AND (Category <= '4'))
  312.             THEN
  313.                BEGIN
  314.                   EntryError := FALSE;     (* Makes sure category is *)
  315.                   Continue := TRUE         (* in the correct range. *)
  316.                END
  317.          ELSE
  318.             BEGIN
  319.                EntryError := TRUE;
  320.                Continue := FALSE
  321.             END;
  322.    UNTIL (Continue);
  323.  
  324. (* This is where the difficulty level is displayed *)
  325. (* and the user's choice of difficulty level is obtained. *)
  326.  
  327.    REPEAT
  328.       CLRSCR;
  329.       WRITELN;
  330.       WRITELN('                    HANGMAN');
  331.       WRITELN;
  332.       WRITELN;
  333.       WRITELN('What difficulty level would you like to start at?');
  334.       WRITELN;
  335.       WRITELN('     1. EASY');
  336.       WRITELN('     2. MEDIUM');
  337.       WRITELN('     3. HARD');
  338.       WRITELN;
  339.       IF (EntryError)        (* Displays error message if needed. *)
  340.          THEN
  341.             BEGIN
  342.                WRITELN('You have entered an incorrect choice.');
  343.                WRITELN('Please reenter your choice (1, 2, 3, or F1 for help).')
  344.             END
  345.          ELSE
  346.             WRITELN('Please enter your choice (1, 2, 3, or F1 for help).');
  347.       DifficultyLevel := READKEY;
  348.       IF (DifficultyLevel = #0)
  349.          THEN
  350.             BEGIN
  351.                DifficultyLevel := READKEY;
  352.                IF (DifficultyLevel = F1)     (* Checks if user asked for help. *)
  353.                   THEN
  354.                      BEGIN
  355.                         DifficultyLevelHelp(NextScreen);
  356.                         EntryError := FALSE;
  357.                         Continue := FALSE
  358.                      END
  359.             END
  360.          ELSE IF ((DifficultyLevel >= '1') AND (DifficultyLevel <= '3'))
  361.             THEN
  362.                BEGIN
  363.                   EntryError := FALSE;    (* Makes sure that user's choice *)
  364.                   Continue := TRUE;       (* is in the range. *)
  365.                END
  366.          ELSE
  367.             BEGIN
  368.                EntryError := TRUE;
  369.                Continue := FALSE
  370.             END;
  371.    UNTIL (Continue)
  372.  
  373. END;
  374.  
  375.  
  376. (*----------------------------------------------------------------*)
  377.  
  378. PROCEDURE GetWord (VAR WordToBeGuessed:
  379.                           StringType32;
  380.                        Category,
  381.                        DifficultyLevel:
  382.                           CHAR;
  383.                        WordRecArray:
  384.                           WordRecArrayType  );
  385.  
  386. (* This procedure is one big IF-THEN-ELSE statement. *)
  387. (* It gets word which the user will guess using a random number *)
  388. (* and the user's choice of category and difficulty level. *)
  389.  
  390. VAR
  391.  
  392.    RandomCategory,
  393.    RandomNum:
  394.       INTEGER;
  395.  
  396. BEGIN
  397.  
  398.    CLRSCR;
  399.    RANDOMIZE;
  400.    RandomNum := RANDOM(70) + 1;
  401.    IF (Category = '1')
  402.       THEN
  403.          BEGIN
  404.             IF (DifficultyLevel = '1')
  405.                THEN
  406.                   WordToBeGuessed := WordRecArray[RandomNum].EasyPlaces
  407.                ELSE IF (DifficultyLevel = '2')
  408.                   THEN
  409.                      WordToBeGuessed := WordRecArray[RandomNum].MediumPlaces
  410.                ELSE
  411.                   WordToBeGuessed := WordRecArray[RandomNum].HardPlaces
  412.          END
  413.       ELSE IF (Category = '2')
  414.          THEN
  415.             BEGIN
  416.                IF (DifficultyLevel = '1')
  417.                   THEN
  418.                      WordToBeGuessed := WordRecArray[RandomNum].EasyThings
  419.                   ELSE IF (DifficultyLevel = '2')
  420.                      THEN
  421.                         WordToBeGuessed := WordRecArray[RandomNum].MediumThings
  422.                   ELSE
  423.                      WordToBeGuessed := WordRecArray[RandomNum].HardThings
  424.             END
  425.       ELSE IF (Category = '3')
  426.          THEN
  427.             BEGIN
  428.                IF (DifficultyLevel = '1')
  429.                   THEN
  430.                      WordToBeGuessed := WordRecArray[RandomNum].EasyPeople
  431.                   ELSE IF (DifficultyLevel = '2')
  432.                      THEN
  433.                         WordToBeGuessed := WordRecArray[RandomNum].MediumPeople
  434.                   ELSE
  435.                      WordToBeGuessed := WordRecArray[RandomNum].HardPeople
  436.             END
  437.  
  438.       ELSE
  439.          BEGIN
  440.             RANDOMIZE;
  441.             RandomCategory := RANDOM(3) +  1;
  442.             IF (RandomCategory = 1)
  443.                THEN
  444.                   BEGIN
  445.                      IF (DifficultyLevel = '1')
  446.                         THEN
  447.                            WordToBeGuessed := WordRecArray[RandomNum].EasyPlaces
  448.                         ELSE IF (DifficultyLevel = '2')
  449.                            THEN
  450.                               WordToBeGuessed := WordRecArray[RandomNum].MediumPlaces
  451.                         ELSE
  452.                            WordToBeGuessed := WordRecArray[RandomNum].HardPlaces
  453.                   END
  454.                ELSE IF (RandomCategory = 2)
  455.                   THEN
  456.                      BEGIN
  457.                         IF (DifficultyLevel = '1')
  458.                            THEN
  459.                               WordToBeGuessed := WordRecArray[RandomNum].EasyThings
  460.                            ELSE IF (DifficultyLevel = '2')
  461.                               THEN
  462.                                  WordToBeGuessed := WordRecArray[RandomNum].MediumThings
  463.                            ELSE
  464.                               WordToBeGuessed := WordRecArray[RandomNum].HardThings
  465.                      END
  466.                ELSE IF (RandomCategory = 3)
  467.                   THEN
  468.                      BEGIN
  469.                         IF (DifficultyLevel = '1')
  470.                            THEN
  471.                               WordToBeGuessed := WordRecArray[RandomNum].EasyPeople
  472.                            ELSE IF (DifficultyLevel = '2')
  473.                               THEN
  474.                                  WordToBeGuessed := WordRecArray[RandomNum].MediumPeople
  475.                            ELSE
  476.                               WordToBeGuessed := WordRecArray[RandomNum].HardPeople
  477.                      END
  478.          END
  479.  
  480. END;
  481.  
  482.  
  483. (*----------------------------------------------------------------*)
  484.  
  485. PROCEDURE DrawStand;
  486.  
  487. BEGIN
  488.  
  489.    (*--------------------------Base---------------------------*)
  490.    SETCOLOR (6); (*Brown*)
  491.    RECTANGLE (450, 370, 580, 430);(*Box*)
  492.    LINE (450, 370, 470, 340);
  493.    LINE (470, 340, 515, 340);
  494.    LINE (539, 340, 600, 340);
  495.    LINE (580, 370, 600, 340);  (*3d Box*)
  496.    LINE (600, 340, 600, 400);
  497.    LINE (600, 400, 580, 430);
  498.    RECTANGLE (515, 100, 535, 353);   (*Vertical Pole*)
  499.    LINE (515, 100, 519, 94);
  500.    LINE (519, 94, 539, 94);
  501.    LINE (535, 353, 539, 347);   (*3d Vertical Pole*)
  502.    LINE (539, 347, 539, 94);
  503.    LINE (535, 100, 539, 94);
  504.    RECTANGLE (360, 100, 515, 120);   (*Horizontal Pole*)
  505.    LINE (360, 100, 364, 94);
  506.    LINE (364, 94, 519, 94);   (*3d Horizontal Pole*)
  507.    LINE (450, 120, 515, 185);  (*Crossbar Support*)
  508.    LINE (465, 120, 515, 170);
  509.    LINE (470, 120, 515, 165);  (*3d Crossbar Support*)
  510.    SETCOLOR (14); (*Yellow*)
  511.    LINE (380, 121, 380, 140); (*Rope*);
  512.    SETCOLOR (15) (*White*)
  513.  
  514. END;
  515.  
  516.  
  517. (*----------------------------------------------------------------*)
  518.  
  519. PROCEDURE DrawHead;
  520.  
  521. BEGIN
  522.  
  523.    CIRCLE (380, 170, 30);       (*Head*)
  524.    CIRCLE (365, 155, 3);        (*Right Eye*)
  525.    CIRCLE (395, 155, 3);        (*Left Eye*)
  526.    CIRCLE (380, 170, 3);        (*Nose*)
  527.    LINE (365, 185, 395, 185);   (*Mouth*)
  528.  
  529. END;
  530.  
  531.  
  532. (*----------------------------------------------------------------*)
  533.  
  534. PROCEDURE DrawBody;
  535.  
  536. BEGIN
  537.  
  538.    LINE (380, 200, 380, 300);(*Body*)
  539.  
  540. END;
  541.  
  542.  
  543. (*----------------------------------------------------------------*)
  544.  
  545. PROCEDURE DrawRightArm;
  546.  
  547. BEGIN
  548.  
  549.    LINE (380, 220, 340, 280);(*Right Arm*)
  550.  
  551. END;
  552.  
  553.  
  554. (*----------------------------------------------------------------*)
  555.  
  556. PROCEDURE DrawLeftArm;
  557.  
  558. BEGIN
  559.  
  560.    LINE (380, 220, 420, 280);(*Left Arm*)
  561.  
  562. END;
  563.  
  564.  
  565. (*----------------------------------------------------------------*)
  566.  
  567. PROCEDURE DrawRightLeg;
  568.  
  569. BEGIN
  570.  
  571.    LINE (380, 300, 340, 385);(*Right Leg*)
  572.  
  573. END;
  574.  
  575.  
  576. (*----------------------------------------------------------------*)
  577.  
  578. PROCEDURE DrawLeftLeg;
  579.  
  580. BEGIN
  581.  
  582.    LINE (380, 300, 420, 385);(*Left Leg*)
  583.  
  584. END;
  585.  
  586.  
  587. (*----------------------------------------------------------------*)
  588.  
  589. PROCEDURE DrawHands;
  590.  
  591. BEGIN
  592.  
  593.    CIRCLE (336, 284, 5);(*Right Hand*)
  594.    CIRCLE (424, 284, 5);(*Left Hand*)
  595.  
  596. END;
  597.  
  598.  
  599. (*----------------------------------------------------------------*)
  600.  
  601. PROCEDURE DrawFeet;
  602.  
  603. BEGIN
  604.  
  605.    CIRCLE (335, 390, 8);(*Right Foot*)
  606.    CIRCLE (425, 390, 8);(*Left Foot*)
  607.  
  608. END;
  609.  
  610.  
  611. (*----------------------------------------------------------------*)
  612.  
  613. PROCEDURE DrawHangmanParts (    NumPartsHangman:
  614.                                     INTEGER    );
  615.  
  616. (* This procedure determines which part of the hangman should be drawn. *)
  617.  
  618. BEGIN
  619.  
  620.    IF (NumPartsHangman = 0)
  621.       THEN
  622.          DrawStand
  623.       ELSE IF (NumPartsHangman = 1)
  624.          THEN
  625.             DrawHead
  626.       ELSE IF (NumPartsHangman = 2)
  627.          THEN
  628.             DrawBody
  629.       ELSE IF (NumPartsHangman = 3)
  630.          THEN
  631.             DrawRightArm
  632.       ELSE IF (NumPartsHangman = 4)
  633.          THEN
  634.             DrawLeftArm
  635.       ELSE IF (NumPartsHangman = 5)
  636.          THEN
  637.             DrawRightLeg
  638.       ELSE IF (NumPartsHangman = 6)
  639.          THEN
  640.             DrawLeftLeg
  641.       ELSE IF (NumPartsHangman = 7)
  642.          THEN
  643.             DrawHands
  644.       ELSE DrawFeet
  645.  
  646. END;
  647.  
  648.  
  649. (*----------------------------------------------------------------*)
  650.  
  651. PROCEDURE SetUp (VAR NumPartsHangman,
  652.                      NumCorrectGuesses,
  653.                      WordLength:
  654.                         INTEGER;
  655.                      Category,
  656.                      DifficultyLevel:
  657.                         CHAR;
  658.                      WordToBeGuessed:
  659.                         StringType32;
  660.                  VAR CorrectGuessArray:
  661.                         CorrectGuessArrayType);
  662.  
  663. (* This procedure sets up the graphics screen for hangman. *)
  664.  
  665. TYPE
  666.    StringType13 = STRING[13];
  667.  
  668. VAR
  669.    CategoryName,
  670.    DifficultyLevelName:
  671.       StringType13;
  672.    Count,
  673.    StringPosition,
  674.    VideoAdapter,
  675.    VideoMode:
  676.       INTEGER;
  677.    TempLetter:
  678.       StringType1;
  679.  
  680. BEGIN
  681.  
  682. (* This IF statement defines CategoryName and DifficultyLevelName *)
  683. (* so that the category and difficulty level can be displayed on the screen. *)
  684.  
  685.    IF (Category = '1')
  686.       THEN
  687.          CategoryName := 'PLACES'
  688.       ELSE IF (Category = '2')
  689.          THEN
  690.             CategoryName := 'THINGS'
  691.       ELSE IF (Category = '3')
  692.          THEN
  693.             CategoryName := 'PEOPLE'
  694.       ELSE CategoryName := 'MISCELLANEOUS';
  695.  
  696.    IF (DifficultyLevel = '1')
  697.       THEN
  698.          DifficultyLevelName := 'EASY'
  699.       ELSE IF (DifficultyLevel = '2')
  700.          THEN
  701.             DifficultyLevelName := 'MEDIUM'
  702.       ELSE DifficultyLevelName := 'HARD';
  703.  
  704.    NumPartsHangman := 0;
  705.    NumCorrectGuesses := 0;
  706.    VideoAdapter := VGA;
  707.    VideoMode := VGAHi;
  708.    INITGRAPH (VideoAdapter, VideoMode,'');
  709.    SETCOLOR (WHITE);
  710.    DrawHangmanParts (NumPartsHangman);
  711.    NumPartsHangman := NumPartsHangman + 1;
  712.    MOVETO (1, 300);
  713.    WordLength := LENGTH (WordToBeGuessed);
  714.    FOR StringPosition := 1 TO WordLength DO   (* Displays word to be guessed *)
  715.       BEGIN                                   (* as a series of dashes. *)
  716.          TempLetter := COPY (WordToBeGuessed, StringPosition, 1);
  717.          IF ((TempLetter = ' ') OR (TempLetter = ',') OR (TempLetter = '.'))
  718.             THEN
  719.                BEGIN
  720.                   OUTTEXT (TempLetter);
  721.                   NumCorrectGuesses := NumCorrectGuesses + 1;
  722.                   CorrectGuessArray[NumCorrectGuesses] := TempLetter
  723.                END
  724.             ELSE
  725.                OUTTEXT ('-')
  726.       END;
  727.    OUTTEXTXY (1, 400, 'Please enter a letter for your guess.');
  728.    OUTTEXTXY (1, 420, '(F1 for a hint. F2 to guess the whole word.)');
  729.    OUTTEXTXY (1, 440, '?');
  730.    SETCOLOR (GREEN);
  731.    OUTTEXTXY (1, 80, 'Category         : ' + CategoryName);
  732.    OUTTEXTXY (1, 100, 'Difficulty Level : ' + DifficultyLevelName);
  733.    SETCOLOR (WHITE)
  734. END;
  735.  
  736.  
  737. (*----------------------------------------------------------------*)
  738.  
  739. PROCEDURE LetterHint(    WordToBeGuessed:
  740.                             StringType32;
  741.                          CorrectGuessArray:
  742.                             CorrectGuessArrayType;
  743.                          GuessArray:
  744.                             GuessArrayType;
  745.                          WordLength,
  746.                          NumCorrectGuesses,
  747.                          NumGuesses:
  748.                             INTEGER              );
  749.  
  750. (* This procedure gives the user some hints on what to guess. *)
  751. (* Three letters are displayed. One is correct and the other two are incorrect. *)
  752.  
  753. CONST
  754.    AlphabetLength = 26;
  755.  
  756. TYPE
  757.    StringType26 = STRING[26];
  758.  
  759. VAR
  760.    Alphabet:
  761.       StringType26;
  762.    TempLetter,
  763.    WrongHintLetter1,
  764.    WrongHintLetter2,
  765.    CorrectHintLetter:
  766.       StringType1;
  767.    Loop:
  768.       BOOLEAN;
  769.    Count,
  770.    RandomNum:
  771.       INTEGER;
  772.  
  773. BEGIN
  774.  
  775.    Alphabet := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  776.    REPEAT
  777.       Loop := FALSE;                      (* Makes sure the letter chosen *)
  778.       RANDOMIZE;                          (* is not already displayed. *)
  779.       RandomNum := RANDOM(WordLength) + 1;
  780.       CorrectHintLetter := COPY (WordToBeGuessed, RandomNum, 1);
  781.       FOR Count := 1 TO NumCorrectGuesses DO   
  782.          BEGIN                                 
  783.             IF (CorrectHintLetter = CorrectGuessArray[Count])
  784.                THEN
  785.                   Loop := TRUE
  786.          END;
  787.    UNTIL NOT(Loop);
  788.  
  789.    REPEAT
  790.       Loop := FALSE;                     (* Makes sure letter chosen is not *)
  791.       RANDOMIZE;                         (* correct or already guessed. *)
  792.       RandomNum := RANDOM(AlphabetLength) + 1;
  793.       WrongHintLetter1 := COPY (Alphabet, RandomNum, 1);
  794.       IF (WrongHintLetter1 = CorrectHintLetter)
  795.          THEN
  796.             Loop := TRUE;
  797.       FOR Count := 1 TO NumGuesses DO
  798.          BEGIN
  799.             IF (WrongHintLetter1 = GuessArray[Count])
  800.                THEN
  801.                   Loop := TRUE
  802.          END;
  803.       FOR Count := 1 TO WordLength DO
  804.          BEGIN
  805.             TempLetter := COPY (WordToBeGuessed, Count, 1);
  806.             IF (WrongHintLetter1 = TempLetter)
  807.                THEN
  808.                   Loop := TRUE
  809.          END
  810.    UNTIL NOT(Loop);
  811.  
  812.    REPEAT
  813.       Loop := FALSE;                     (* Makes sure letter chosen is not *)
  814.       RANDOMIZE;                         (* correct or already guessed. *)
  815.       RandomNum := RANDOM(AlphabetLength) + 1;
  816.       WrongHintLetter2 := COPY (Alphabet, RandomNum, 1);
  817.       IF ((WrongHintLetter2 = CorrectHintLetter) OR (WrongHintLetter2 = WrongHintLetter1))
  818.          THEN
  819.             Loop := TRUE;
  820.       FOR Count := 1 TO NumGuesses DO
  821.          BEGIN
  822.             IF (WrongHintLetter2 = GuessArray[Count])
  823.                THEN
  824.                   Loop := TRUE
  825.          END;
  826.       FOR Count := 1 TO WordLength DO
  827.          BEGIN
  828.             TempLetter := COPY (WordToBeGuessed, Count, 1);
  829.             IF (WrongHintLetter2 = TempLetter)
  830.                THEN
  831.                   Loop := TRUE
  832.          END
  833.    UNTIL NOT(Loop);
  834.  
  835.    OUTTEXTXY (1, 140, 'Three letters have been chosen at random.');
  836.    OUTTEXTXY (1, 160, 'One of the three is correct.');
  837.    OUTTEXTXY (1, 180, 'Make your choice.');
  838.    SETCOLOR (MAGENTA);
  839.    RANDOMIZE;
  840.    RandomNum := RANDOM (3) + 1;
  841.    IF (RandomNum = 1)        (* Displays the three letters in random order. *)
  842.       THEN
  843.          OUTTEXTXY (1, 220, CorrectHintLetter + '     ' + WrongHintLetter1 + '     ' + WrongHintLetter2)
  844.       ELSE IF (RandomNum = 2)
  845.          THEN
  846.             OUTTEXTXY (1, 220, WrongHintLetter1 + '     ' + CorrectHintLetter + '     ' + WrongHintLetter2)
  847.       ELSE OUTTEXTXY (1, 220, WrongHintLetter1 + '     ' + WrongHintLetter2 + '     ' + CorrectHintLetter);
  848.  
  849.    SETCOLOR (WHITE)
  850.  
  851. END;
  852.  
  853.  
  854. (*----------------------------------------------------------------*)
  855.  
  856. PROCEDURE EraseHintProcedure;
  857.  
  858. (* This procedure erases all letter output leftover from the Hint procedure. *)
  859.  
  860. BEGIN
  861.  
  862.    SETCOLOR (BLACK);
  863.    OUTTEXTXY (1, 140, 'Three letters have been chosen at random.');
  864.    OUTTEXTXY (1, 160, 'One of the three is correct.');
  865.    OUTTEXTXY (1, 180, 'Make your choice.');
  866.    OUTTEXTXY (1, 220, '█     █     █');
  867.    SETCOLOR (WHITE)
  868.  
  869. END;
  870.  
  871.  
  872. (*----------------------------------------------------------------*)
  873.  
  874. PROCEDURE GuessCompleteWord(    OldGuess:
  875.                                    CHAR;
  876.                                 WordToBeGuessed:
  877.                                    StringType32;
  878.                             VAR Won,
  879.                                 Continue,
  880.                                 InvalidWord,
  881.                                 AnotherHangmanPart,
  882.                                 EraseInvalidMessage:
  883.                                    BOOLEAN;
  884.                                 WordLength:
  885.                                    INTEGER          );
  886.  
  887.  
  888. (* This procedure allows the user to guess the whole word at once. *)
  889.  
  890. CONST
  891.    Enter = #13;
  892.    BackSpace = #8;
  893.  
  894. TYPE
  895.    StringType50 = STRING[50];
  896.  
  897. VAR
  898.    Count,
  899.    WordSize:
  900.       INTEGER;
  901.    WordDone:
  902.       BOOLEAN;
  903.    BackSpaceLetter:
  904.       StringType1;
  905.    TempLetterGuess:
  906.       CHAR;
  907.    WordGuess:
  908.       StringType50;
  909.  
  910. BEGIN
  911.  
  912.    WordSize := 0;
  913.    WordDone := FALSE;
  914.    WordGuess := '';
  915.    SETCOLOR (BLACK);
  916.    OUTTEXTXY (20, 440, OldGuess);
  917.    OUTTEXTXY (1, 400, 'Please enter a letter for your guess.');
  918.    OUTTEXTXY (1, 420, '(F1 for a hint. F2 to guess the whole word.)');
  919.    SETCOLOR (WHITE);
  920.    OUTTEXTXY (1, 380, 'Please enter the word for your guess.');
  921.    OUTTEXTXY (1, 400, 'Type in your guess and press enter.');
  922.    OUTTEXTXY (1, 420, '(Just press return to exit without guessing.)');
  923.    MOVETO (20, 440);
  924.  
  925. (* This REPEAT-UNTIL is my personal favorite. Graphics mode does not have *)
  926. (* a READLN statement.  I emulated a READLN statement by allowing the user *)
  927. (* to input using READKEY. Then I display that letter and add it to the *)
  928. (* word string. *)
  929.  
  930.    REPEAT
  931.       TempLetterGuess := READKEY;
  932.       TempLetterGuess := UPCASE(TempLetterGuess);
  933.       IF ((TempLetterGuess >= 'A') AND (TempLetterGuess <= 'Z') AND NOT(TempLetterGuess = #0))
  934.          THEN
  935.             BEGIN
  936.                OUTTEXTXY ((WordSize * 8) + 20, 440, TempLetterGuess);
  937.                WordSize := WordSize + 1;
  938.                WordGuess := WordGuess + TempLetterGuess
  939.             END
  940.          ELSE IF ((TempLetterGuess = ' ') OR (TempLetterGuess =',') OR (TempLetterGuess = '.'))
  941.             THEN
  942.                BEGIN
  943.                   OUTTEXTXY ((WordSize * 8) + 20, 440, TempLetterGuess);
  944.                   WordSize := WordSize + 1;
  945.                   WordGuess := WordGuess + TempLetterGuess
  946.                END
  947.          ELSE IF (TempLetterGuess = Enter)
  948.             THEN
  949.                WordDone := TRUE
  950.          ELSE IF (TempLetterGuess = BackSpace)
  951.             THEN
  952.                BEGIN
  953.                   IF NOT(WordSize = 0)
  954.                      THEN
  955.                         BEGIN
  956.                            BackSpaceLetter := COPY (WordGuess, WordSize, 1);
  957.                            SETCOLOR (BLACK);
  958.                            OUTTEXTXY (((WordSize - 1) * 8) + 20, 440, BackSpaceLetter);
  959.                            SETCOLOR (WHITE);
  960.                            WordSize := WordSize - 1;
  961.                            WordGuess := COPY(WordGuess, 1, WordSize)
  962.                         END
  963.                END;
  964.  
  965.    UNTIL ((WordDone) OR (WordSize >= 50));
  966.  
  967.    
  968.    SETCOLOR (BLACK);
  969.    OUTTEXTXY (1, 380, 'Please enter the word for your guess.');
  970.    OUTTEXTXY (1, 400, 'Type in your guess and press enter.');
  971.    OUTTEXTXY (1, 420, '(Just press return to exit without guessing.)');
  972.    OUTTEXTXY (20, 440, WordGuess);
  973.    SETCOLOR (WHITE);
  974.    OUTTEXTXY (1, 400, 'Please enter a letter for your guess.');
  975.    OUTTEXTXY (1, 420, '(F1 for a hint. F2 to guess the whole word.)');
  976.  
  977. (* This IF statement set boolean variables that relay *)
  978. (* if the answer was correct or not. *)
  979.  
  980.    IF (WordSize >= 50)
  981.       THEN
  982.          BEGIN
  983.             InvalidWord := TRUE;
  984.             EraseInvalidMessage := TRUE;
  985.             OUTTEXTXY (1, 140, 'The word you entered is too long.');
  986.             OUTTEXTXY (1, 160, 'Please try again.')
  987.          END
  988.       ELSE IF (WordSize = 0)
  989.           THEN
  990.              BEGIN
  991.                 InvalidWord := FALSE;
  992.                 AnotherHangmanPart := FALSE
  993.              END
  994.       ELSE
  995.          BEGIN
  996.             InvalidWord := FALSE;
  997.             IF (WordGuess = WordToBeGuessed)
  998.                THEN
  999.                   BEGIN
  1000.                      Won := True;
  1001.                      Continue := FALSE;
  1002.                      AnotherHangmanPart := FALSE;
  1003.                      SETCOLOR (BLACK);
  1004.                      MOVETO (1, 300);
  1005.                      FOR Count := 1 TO WordLength DO
  1006.                         BEGIN
  1007.                            OUTTEXTXY (((Count - 1) * 8) + 1, 300, '-');
  1008.                         END;
  1009.                      SETCOLOR (WHITE);
  1010.                      OUTTEXTXY (1, 300, WordToBeGuessed)
  1011.                   END
  1012.                ELSE
  1013.                   BEGIN
  1014.                      AnotherHangmanPart := TRUE;
  1015.                      CONTINUE := False
  1016.                   END
  1017.           END
  1018.       
  1019. END;
  1020.  
  1021.  
  1022. (*----------------------------------------------------------------*)
  1023.  
  1024. PROCEDURE EraseInvalidMessageProcedure;
  1025.  
  1026. (* This procedure erases the error message that *)
  1027. (* may have been left by the GuessWord procedure. *)
  1028.  
  1029. BEGIN
  1030.  
  1031.    SETCOLOR (BLACK);
  1032.    OUTTEXTXY (1, 140, 'The word you entered is too long.');
  1033.    OUTTEXTXY (1, 160, 'Please try again.');
  1034.    SETCOLOR (WHITE)
  1035.  
  1036. END;
  1037.  
  1038.  
  1039. (*----------------------------------------------------------------*)
  1040.  
  1041. PROCEDURE Guessing (    NumPartsHangman,
  1042.                         NumCorrectGuesses,
  1043.                         WordLength:
  1044.                            INTEGER;
  1045.                         GuessArray:
  1046.                            GuessArrayType;
  1047.                         WordToBeGuessed:
  1048.                            StringType32;
  1049.                     VAR Won:
  1050.                            BOOLEAN;
  1051.                         CorrectGuessArray:
  1052.                            CorrectGuessArrayType);
  1053.  
  1054. (* This procedure is the heart of the program. *)
  1055. (* It runs all guessing that the user does. *)
  1056.  
  1057. VAR
  1058.    TempLetter:
  1059.       StringType1;
  1060.    Count,
  1061.    StringPosition,
  1062.    NumGuesses:
  1063.       INTEGER;
  1064.    InvalidWord,
  1065.    AnotherHangmanPart,
  1066.    EraseInvalidMessage,
  1067.    EraseHint,
  1068.    Continue,
  1069.    CorrectGuess,
  1070.    RepeatGuess:
  1071.       BOOLEAN;
  1072.    OldGuess,
  1073.    Guess:
  1074.       CHAR;
  1075. BEGIN
  1076.  
  1077.    EraseHint := FALSE;
  1078.    OldGuess := ' ';
  1079.    NumGuesses := 0;
  1080.    Continue := TRUE;
  1081.    WHILE (Continue) DO       (* This WHILE loop contains *)
  1082.      BEGIN                   (* the entire guessing procedure. *)
  1083.        RepeatGuess := FALSE;
  1084.        Guess := READKEY;
  1085.        IF (EraseHint)
  1086.           THEN          (* Erases leftovers from Hint procedure if present. *)
  1087.              BEGIN
  1088.                 EraseHintProcedure;
  1089.                 EraseHint := FALSE
  1090.              END;
  1091.        Guess := UPCASE(Guess);
  1092.        IF ((Guess >= 'A') AND (Guess <= 'Z') AND NOT(Guess = '#0'))
  1093.          THEN                         (* If a letter was pressed, this IF *)
  1094.            BEGIN                      (* checks if it belongs in the word.*)
  1095.              IF (NumGuesses >= 1)
  1096.                THEN
  1097.                  BEGIN            (* Validates guess isn't a repeated guess. *)
  1098.                    FOR Count := 1 TO NumGuesses DO
  1099.                      BEGIN
  1100.                        IF (Guess = GuessArray[Count])
  1101.                          THEN
  1102.                            RepeatGuess := TRUE;
  1103.                      END
  1104.                  END;
  1105.              IF NOT(RepeatGuess)
  1106.                THEN
  1107.                  BEGIN
  1108.                    SETCOLOR (BLACK);
  1109.                    OUTTEXTXY (20, 440, OldGuess);
  1110.                    SETCOLOR (WHITE);
  1111.                    OUTTEXTXY (20, 440, Guess);    (* Displays user's guess. *)
  1112.                    NumGuesses := NumGuesses + 1;                                               GuessArray[NumGuesses] := Guess;
  1113.                    SETCOLOR (LIGHTCYAN);
  1114.                    OUTTEXTXY ((NumGuesses * 20), 30, Guess);
  1115.                    SETCOLOR (WHITE);
  1116.                    OldGuess := Guess;
  1117.                    CorrectGuess := FALSE;
  1118.                    FOR StringPosition := 1 TO WordLength DO
  1119. (* This FOR loop *)  BEGIN
  1120. (* checks if the *)    TempLetter := COPY (WordToBeGuessed, StringPosition, 1);
  1121. (* guessed letter *)   IF (Guess = TempLetter)
  1122. (* is in the word *)     THEN
  1123. (* to be guessed. *)       BEGIN
  1124. (* If so, it displays *)     SETCOLOR (BLACK);
  1125. (* the letter in the *)      OUTTEXTXY (((StringPosition - 1)* 8)+ 1, 300, '-');
  1126. (* correct place in *)       SETCOLOR (WHITE);
  1127. (* the dashes. *)            OUTTEXTXY (((StringPosition - 1)* 8)+ 1, 300, TempLetter);
  1128.                              NumCorrectGuesses := NumCorrectGuesses + 1;
  1129.                              CorrectGuess := TRUE;
  1130.                              CorrectGuessArray[NumCorrectGuesses] := TempLetter
  1131.                            END
  1132.                      END;
  1133.                      IF NOT(CorrectGuess)
  1134.                       THEN
  1135. (* If not a correct *)  BEGIN
  1136. (* guess, a piece of *)   DrawHangmanParts(NumPartsHangman);
  1137. (* the hangman is *)      NumPartsHangman := NumPartsHangman + 1
  1138. (* drawn. *)            END;
  1139.                  Continue := ((NumCorrectGuesses < WordLength)  AND (NumPartsHangman < 9));
  1140.                  IF NOT(Continue)
  1141.                    THEN           (* Validates if user won or not. *)
  1142.                      BEGIN
  1143.                        IF (NumCorrectGuesses = WordLength)
  1144.                          THEN
  1145.                            Won := TRUE
  1146.                          ELSE
  1147.                            Won := FALSE
  1148.                      END
  1149.                  END
  1150.            END
  1151.         ELSE IF (Guess = #0)
  1152.           THEN                 (* If the user's choice was a function key or *)
  1153.             BEGIN              (* other similar key it checks for F1 and F2. *)
  1154.               Guess := READKEY;
  1155.               IF (Guess = F1)
  1156.                 THEN
  1157.                   BEGIN
  1158. (* Runs the hint *)  LetterHint(WordToBeGuessed, CorrectGuessArray, GuessArray,
  1159. (* procedure. *)     WordLength, NumCorrectGuesses, NumGuesses);
  1160.                      EraseHint := TRUE
  1161.                   END
  1162.                 ELSE IF (Guess = F2)
  1163.                   THEN
  1164.                     BEGIN
  1165.                       EraseInvalidMessage := FALSE;
  1166.                       REPEAT
  1167. (* Runs the guess *)    GuessCompleteWord(OldGuess, WordToBeGuessed, Won, Continue,
  1168. (* word procedure. *)      InvalidWord, AnotherHangmanPart, EraseInvalidMessage, WordLength);
  1169.                       UNTIL NOT(InvalidWord);
  1170.                       IF (EraseInvalidMessage)
  1171.                         THEN
  1172.                           BEGIN
  1173.                             EraseInvalidMessageProcedure;
  1174.                             EraseInvalidMessage := FALSE
  1175.                           END;
  1176.                       IF (AnotherHangmanPart)
  1177.                          THEN
  1178.                             BEGIN
  1179.                               DrawHangmanParts(NumPartsHangman);
  1180.                               NumPartsHangman := NumPartsHangman + 1
  1181.                             END
  1182.                    END
  1183.             END
  1184.  
  1185.      END
  1186.  
  1187. END;
  1188.  
  1189.  
  1190. (*----------------------------------------------------------------*)
  1191.  
  1192. PROCEDURE PostGuessingMessage(    WordToBeGuessed:
  1193.                                      StringType32;
  1194.                                   Won:
  1195.                                      BOOLEAN;
  1196.                                   NextScreen:
  1197.                                      CHAR        );
  1198.  
  1199.  
  1200. (* This procedure displays an appropriate message if the user won or lost. *)
  1201.  
  1202. BEGIN
  1203.  
  1204.    IF (Won)
  1205.       THEN
  1206.          BEGIN
  1207.             OUTTEXTXY (1, 150, 'Congratulations on a well-played game!');
  1208.             OUTTEXTXY (1, 170, 'You won this time, but can you win again?')
  1209.          END
  1210.       ELSE
  1211.          BEGIN
  1212.             SETCOLOR (BLACK);
  1213.             CIRCLE (365, 155, 3);        (*Right Eye*)
  1214.             CIRCLE (395, 155, 3);        (*Left Eye*)
  1215.             SETCOLOR (WHITE);
  1216.             OUTTEXTXY (362, 151, 'X');
  1217.             OUTTEXTXY (392, 151, 'X');
  1218.             OUTTEXTXY (1, 150, 'Sorry but you did not stop Zeb');
  1219.             OUTTEXTXY (1, 170, '       from being hung.');
  1220.             OUTTEXTXY (1, 190, 'The correct word is ' + WordToBeGuessed + '.')
  1221.          END;
  1222.    SETCOLOR (RED);
  1223.    OUTTEXTXY (1, 230, 'Press any key to continue.');
  1224.    SETCOLOR (WHITE);
  1225.    NextScreen := READKEY;
  1226.    IF (NextScreen = #0)
  1227.       THEN
  1228.          NextScreen := READKEY
  1229.  
  1230. END;
  1231.  
  1232.  
  1233. (*----------------------------------------------------------------*)
  1234. PROCEDURE DesirePlayAgain(VAR PlayAgain:
  1235.                             CHAR;
  1236.                          EntryError,
  1237.                          Continue:
  1238.                             BOOLEAN;
  1239.                          NextScreen:
  1240.                             CHAR    );
  1241.  
  1242. (* This procedure obtain the user's choice to play again or not. *)
  1243.  
  1244. BEGIN
  1245.  
  1246.    RESTORECRTMODE;
  1247.    EntryError := FALSE;
  1248.    REPEAT
  1249.       CLRSCR;
  1250.       WRITELN;
  1251.       WRITELN('                    HANGMAN');
  1252.       WRITELN;
  1253.       WRITELN;
  1254.       WRITELN('Would you like to play again (Y or N)? (F1 for help).');
  1255.       IF (EntryError)
  1256.          THEN               (* Displays error message if needed. *)
  1257.             BEGIN
  1258.                WRITELN;
  1259.                WRITELN('You have entered an invalid code.');
  1260.                WRITELN('Please reenter your choice.')
  1261.             END;
  1262.       PlayAgain := READKEY;
  1263.       IF (PlayAgain = #0)
  1264.          THEN
  1265.             BEGIN
  1266.                PlayAgain := READKEY;
  1267.                IF (PlayAgain = F1)
  1268.                   THEN             (* Obtains if user asked for help. *)
  1269.                      BEGIN
  1270.                         PlayAgainHelp(NextScreen);
  1271.                         EntryError := FALSE;
  1272.                         Continue := FALSE
  1273.                      END
  1274.             END
  1275.          ELSE IF ((PlayAgain = 'Y') OR (PlayAgain = 'y') OR (PlayAgain = 'N') OR (PlayAgain = 'n'))
  1276.             THEN
  1277.                BEGIN
  1278.                   EntryError := FALSE;      (* Decides if user played again *)
  1279.                   Continue := TRUE;         (* or not. *)
  1280.                END
  1281.          ELSE
  1282.             BEGIN
  1283.                EntryError := TRUE;
  1284.                Continue := FALSE
  1285.             END
  1286.    UNTIL (Continue)
  1287.  
  1288. END;
  1289.  
  1290.  
  1291. (*----------------------------------------------------------------*)
  1292.  
  1293. PROCEDURE PlayTheGame (    Category,
  1294.                            DifficultyLevel,
  1295.                            PlayAgain,
  1296.                            NextScreen:
  1297.                               CHAR;
  1298.                            WordToBeGuessed:
  1299.                               StringType32;
  1300.                            EntryError,
  1301.                            Continue:
  1302.                               BOOLEAN;
  1303.                            WordRecArray:
  1304.                               WordRecArrayType;
  1305.                            GuessArray:
  1306.                               GuessArrayType   );
  1307.  
  1308. (* This procedure runs the whole user interface of the game. *)
  1309. (* It calls all the procedures to run the game part itself. *)
  1310.  
  1311. VAR
  1312.    CorrectGuessArray:
  1313.       CorrectGuessArrayType;
  1314.    Won:
  1315.       BOOLEAN;
  1316.    NumCorrectGuesses,
  1317.    WordLength,
  1318.    NumPartsHangman:
  1319.       INTEGER;
  1320.  
  1321. BEGIN
  1322.  
  1323.    PlayAgain := 'Y';
  1324.    WHILE (PlayAgain = 'y') OR (PlayAgain = 'Y') DO
  1325.       BEGIN
  1326.          Options(Category, DifficultyLevel, NextScreen, EntryError, Continue);
  1327.          GetWord(WordToBeGuessed, Category, DifficultyLevel, WordRecArray);
  1328.          SetUp(NumPartsHangman, NumCorrectGuesses, WordLength, Category,
  1329.                 DifficultyLevel, WordToBeGuessed, CorrectGuessArray);
  1330.          Guessing(NumPartsHangman, NumCorrectGuesses, WordLength, GuessArray,
  1331.                 WordToBeGuessed, Won, CorrectGuessArray);
  1332.          PostGuessingMessage(WordToBeGuessed, Won, NextScreen);
  1333.          DesirePlayAgain(PlayAgain, EntryError, Continue, NextScreen)
  1334.       END
  1335.  
  1336. END;
  1337.  
  1338.  
  1339. (*----------------------------------------------------------------*)
  1340.  
  1341. PROCEDURE Finalize(    NextScreen:
  1342.                           CHAR    );
  1343.  
  1344. (* Thanks the user for playing. *)
  1345.  
  1346. BEGIN
  1347.  
  1348.    CLRSCR;
  1349.    WRITELN;
  1350.    WRITELN('                   HANGMAN');
  1351.    WRITELN;
  1352.    WRITELN;
  1353.    WRITELN('I hope you enjoyed this game.  Thank you for playing.');
  1354.    WRITELN('Please play again soon.');
  1355.    WRITELN;
  1356.    WRITELN;
  1357.    WRITELN('Press any key to exit.');
  1358.    NextScreen := READKEY
  1359.  
  1360. END;
  1361.  
  1362.  
  1363.  
  1364.  
  1365. (*------------------------ Main Program -------------------------*)
  1366.  
  1367. BEGIN
  1368.  
  1369.    Introduction(WordRecArray, NextScreen);
  1370.    PlayTheGame(Category, DifficultyLevel, PlayAgain, NextScreen,
  1371.            WordToBeGuessed, EntryError, Continue, WordRecArray, GuessArray);
  1372.    Finalize(NextScreen)    (* RIP ZEB *)
  1373.  
  1374. END.